home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 June / EnigmA AMIGA RUN 08 (1996)(G.R. Edizioni)(IT)[!][issue 1996-06][EARSAN CD VII].iso / earcd / arexx / rxdssppr.lha / rexxdossupport / txt / RexxDosSupport.mod next >
Text File  |  1996-03-20  |  49KB  |  1,546 lines
  1. (*(***********************************************************************
  2.  
  3. :Program.    rexxdossupport.mod
  4. :Contents.   access to V37+ Dos.library functions from within ARexx
  5. :Author.     hartmtut Goebel [hG]
  6. :Address.    Aufseßplatz 5, D-90459 Nürnberg
  7. :Address.    UseNet: hartmut@oberon.nbg.sub.org
  8. :Copyright.  Copyright © 1994-1996 by hartmtut Goebel
  9. :Language.   Oberon-2
  10. :Translator. Amiga Oberon 3.11
  11. :Imports.    Printf (Martin Horneffer), RxLibsSupport [hG]
  12. :Version.    $VER: rexxdossupport.mod 3.4 (20.3.96) Copyright © 1994-1996 by hartmtut Goebel
  13.  
  14. (* $StackChk- $NilChk- $RangeChk- $CaseChk- $OvflChk- $ReturnChk- $ClearVars- *)
  15. (****** rexxdossupport.library/--history-- **********************
  16. *
  17. *
  18. *  3.4  20 Mar 1996
  19. *       · fixed FilePart(): last charakter has been stripped
  20. *         (ack: Nick Ring)
  21. *  3.3  06 Mar 1996
  22. *       · revised autodocs a bit
  23. *  3.2  23 Feb 1996
  24. *       · improofed docs about accessing local environment varibales
  25. *       · fixed some erratas
  26. *  3.1  16 Feb 1996
  27. *       · new functions: AddPart(), FilePart(), PathPart()
  28. *         (suggested many times)
  29. *       · ReadArgs supports /T now (suggested by Magnus Holgren)
  30. *  3.0  17 Jan 1996 [Kai Bolay]
  31. *       · new function: AbsolutePath()
  32. *
  33. *  2.4  11 Oct 1995
  34. *       · fixed memory lose in ReadArgs (ack: Alexander Stirmlinger)
  35. *       · ReadArgs example is now complete (ack: Oliver Creighton)
  36. *  2.3  01 Apr 1995
  37. *       · fixed problem with synonyms: foo=bar lead to illegal
  38. *         variable named 'FOO=BAR'. Now allways th first synonym is
  39. *         taken as var-name.
  40. *  2.2  18 Jul 1994
  41. *       · Shame on me! library names must be lowercase
  42. *       · Some more notes in documentation
  43. *  2.1  03 Jun 1994
  44. *       · removed curious bug in ReadArgs() (uninitialized var,
  45. *         introduced in V2.0)
  46. *  2.0  07 May 1994 (never released)
  47. *       · stronger check for present args to avoid NIL-Traps
  48. *       · new functions: Delete(), Rename(), MakeDir(),
  49. *                        SetComment(), SetProtection()
  50. *  1.4  01 Feb 1994
  51. *       · only significant part of parsed pattern is copied
  52. *         into the ARexx Argstring
  53. *  1.3  23 Jan 1994
  54. *       · uses module RxLibsSupport [hG]
  55. *  1.2  18 Jan 1994
  56. *       · finished dokumentation
  57. *       · UnsetVar() - like shell commnad - renamed to
  58. *         DeleteVar() - like in dos.library
  59. *       · SetVar() no longer accepts option "Binary"
  60. *  1.1  16 Jan 1994
  61. *       initial release
  62. *
  63. *******
  64. (****** rexxdossupport.library/--Disclaimer-- **********************
  65. *
  66. *Disclaimer
  67. *----------
  68. *
  69. *   Permission is granted to make and distribute verbatim copies  of  this
  70. *manual provided the copyright  notice  and  this  permission  notice  are
  71. *preserved on all copies.
  72. *
  73. *COPYRIGHT
  74. *
  75. *   Copyright (C) 1994-1996 by hartmut Goebel
  76. *
  77. *   No program, document, data file or  source  code  from  this  software
  78. *package, neither in whole nor in part, may be included or used  in  other
  79. *software packages unless it is authorized by a  written  permission  from
  80. *the author.
  81. *
  82. *
  83. *NO WARRANTY
  84. *
  85. *   There is no warranty for this software package.  Although  the  author
  86. *has tried to prevent errors, he can't guarantee that the software package
  87. *described in this document is 100% reliable. You are therefore using this
  88. *material at your own risk. The author cannot be made responsible for  any
  89. *damage which is caused by using this software package.
  90. *
  91. *
  92. *DISTRIBUTION
  93. *
  94. *   This software package is freely distributable. It may be  put  on  any
  95. *media which is used for the distribution of free  software,  like  Public
  96. *Domain disk collections, CDROMs, FTP servers or bulletin board systems.
  97. *
  98. *   In  order  to  ensure  the  integrity  of   this   software   package,
  99. *distributors should use the original archive file  rexxdossuppor.lha.
  100. *The author cannot be  made  responsible  if  this software  package   has
  101. *become unusable due to modifications of  the  archive  contents   or   of
  102. *the archive file itself.
  103. *
  104. *   There is no limit on the costs  of  the  distribution,  e.g.  for  the
  105. *media, like floppy disks, streamer tapes or compact disks, or the process
  106. *of duplicating. Such limits have been proven to be harmful to the idea of
  107. *freely distributable software, e.g. instead of reducing the price of  the
  108. *floppy disk below the limit, the software was  simply  removed  from  the
  109. *master disk.
  110. *
  111. *   Although the author does not impose any limit on the  distribution  of
  112. *this software package, he would like to express his personal opinions  on
  113. *this matter:
  114. *
  115. *   * This software package should be made available to everyone  free  of
  116. *     charge whenever it is possible.
  117. *
  118. *   * If you have acquired this software package under  normal  conditions
  119. *     from a Public Domain dealer on a floppy disk at a price higher  than
  120. *     5DM or US $5, then you have definitely paid too much.  Please  don't
  121. *     support this improper profit making  any  longer  and  switch  to  a
  122. *     cheaper source as soon as possible.
  123. *
  124. *
  125. *USAGE RESTRICTIONS
  126. *
  127. *   No program, document, data file or  source  code  from  this  software
  128. *package, neither in whole nor in part, may be used on any  machine  which
  129. *is used
  130. *
  131. *   * for the research, development, construction, testing  or  production
  132. *     of weapons or other military applications. This  also  includes  any
  133. *     machine which is  used  in  the  education  for  any  of  the  above
  134. *     mentioned purposes.
  135. *
  136. *   * by people who accept, support or use violence against other  people,
  137. *     e.g. citizens from foreign countries.
  138. *
  139. *********)*)*)*)
  140. (****** rexxdossupport.library/--background-- *******************
  141. *
  142. *                rexxdossupport.library 3.4
  143. *                ==========================
  144. *
  145. *         Copyright (C) 1994-1996 by hartmut Goebel
  146. *
  147. *
  148. *   After programming ARexx script for quite a while, I missed some
  149. *   function found in dos.library --  especially access to
  150. *   environment variables and the comfortable argument parsing. Since
  151. *   there seamed to be no ARexx function library which implements
  152. *   this functions, I decited to write my own. And here it is.
  153. *
  154. *   This are the functions handled by this library.
  155. *   · ReadArgs()
  156. *   · GetVar(), SetVar(), DeleteVar()
  157. *   · ParsePattern(), MatchPattern() - even case-insensitive
  158. *   · Fault()
  159. *   · Delete(), Rename(), MakeDir()
  160. *   · SetComment(), SetProtection()
  161. *   · FilePart(), PathPart(), AddPart()
  162. *
  163. *   This additional functions have been added for your convinience:
  164. *   · AbsolutePath()
  165. *
  166. *   Enjoy it!
  167. *   +++hartmut
  168. *
  169. *********)
  170. (****** rexxdossupport.library/--installation-- *******************
  171. *
  172. *   To use rexxdossupport.library, just copy is to yout LIBS:
  173. *   directory. That's all.
  174. *
  175. *   The LVO for the ARexx-Dispatcher is -30.
  176. *       NB: it's the only LVO for this library :-)
  177. *
  178. *   So, in every ARexx-Script you want to use rexxdossupport.library,
  179. *   insert
  180. *
  181. *      call addlib("rexxdossupport.library",0,-30,2)
  182. *
  183. *   somewhere before the first call to one of the routines
  184. *   implemented in this library.
  185. *   Since ARexx does not check whether the lib can be opened but only
  186. *   inserts the name into a list, the result value from addlib() can
  187. *   be ignored in most cases. The value would be interesting to check
  188. *   if the added note will require the same library version, but I
  189. *   don't know how to find this out.
  190. *
  191. *********)
  192.  
  193. MODULE rexxdossupport;
  194. (* $StackChk- $ClearVars- *)
  195.  
  196. IMPORT
  197.   d := Dos,
  198.   e := Exec,
  199.   str := Strings,
  200.   ol := OberonLib,
  201.   pf := Printf,
  202.   PointerArithmetics,
  203.   rx := Rexx,
  204.   rxs := RexxSysLib,
  205.   rvi := RVI,
  206.   rls := RxLibsSupport,
  207.   y := SYSTEM;
  208.  
  209. CONST
  210.   versionString = "$VER: rexxdossupport 3.4 (20.3.96) Copyright © 1994-1996 by hartmtut Goebel";
  211.  
  212.   progNotFound = rls.progNotFound;
  213.   noMemory     = rls.noMemory;
  214.   badNumArgs   = rls.badNumArgs;
  215.   stringTooLong= rx.err10009;
  216.   funcErr      = rx.err10012;
  217.   invalidArg   = rx.err10018;
  218.   nestingLevel = rx.err10043;
  219.   invalidTemplate = rx.err10037;
  220.   errorReturnFromFunc = rx.err10012;
  221.   arithConvertionErr = rx.err10047;
  222.  
  223.   strTRUE  = rls.strTRUE;
  224.   strFALSE = rls.strFALSE;
  225.  
  226. PROCEDURE ^ GetVar (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  227. PROCEDURE ^ SetVar (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  228. PROCEDURE ^ DeleteVar (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  229. PROCEDURE ^ MatchPattern (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  230. PROCEDURE ^ ParsePattern (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  231. PROCEDURE ^ Fault (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  232. PROCEDURE ^ ReadArgs (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  233. (* new for V2.0 *)
  234. PROCEDURE ^ Delete (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  235. PROCEDURE ^ Rename (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  236. PROCEDURE ^ MakeDir (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  237. PROCEDURE ^ SetComment (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  238. PROCEDURE ^ SetProtection (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  239. (* new for v3.0 *)
  240. PROCEDURE ^ AbsolutePath (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  241. (* new for v3.1 *)
  242. PROCEDURE ^ FilePart (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  243. PROCEDURE ^ PathPart (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  244. PROCEDURE ^ AddPart (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  245.  
  246. CONST
  247.   numFunctions = 16;
  248.  
  249. TYPE
  250.   FunctionList = ARRAY numFunctions OF rls.FunctionListEntry;
  251.  
  252. CONST
  253.   functionList = FunctionList(
  254.     y.ADR("GetVar"),1,3,GetVar,
  255.     y.ADR("SetVar"),2,3,SetVar,
  256.     y.ADR("DeleteVar"),1,2,DeleteVar,
  257.     y.ADR("MatchPattern"),2,4,MatchPattern,
  258.     y.ADR("ParsePattern"),1,2,ParsePattern,
  259.     y.ADR("Fault"),1,2,Fault,
  260.     y.ADR("ReadArgs"),2,3,ReadArgs,
  261.     y.ADR("Delete"),1,1,Delete,
  262.     y.ADR("Rename"),2,2,Rename,
  263.     y.ADR("SetComment"),2,2,SetComment,
  264.     y.ADR("SetProtection"),2,2,SetProtection,
  265.     y.ADR("MakeDir"),1,1,MakeDir,
  266.     y.ADR("AddPart"),2,2,AddPart,
  267.     y.ADR("FilePart"),1,1,FilePart,
  268.     y.ADR("PathPart"),1,1,PathPart,
  269.     y.ADR("AbsolutePath"),1,1,AbsolutePath
  270.   );
  271.  
  272. (* ---------------------------------------------------------------- *)
  273.  
  274. (****** rexxdossupport.library/ReadArgs ***************
  275. *
  276. *   NAME
  277. *       ReadArgs -- Parse argument string using Dos/ReadArgs()
  278. *
  279. *   SYNOPSIS
  280. *       okay = ReadArgs( arguments, template, [stem] )
  281. *
  282. *   FUNCTION
  283. *       Parses an argument string according to a template. See
  284. *       dos.library/ReadArgs() for details and describtion of the
  285. *       template.
  286. *
  287. *       This function supports the following template options:
  288. *
  289. *       /S - Switch.  Resulting variable will be either true (1) or
  290. *            false (0).
  291. *       /T - Toggle.  (V3) Results like /S, but much more mighty,
  292. *                     see below.
  293. *       /N - Number.
  294. *       /M - Multiple strings.  See below for further information.
  295. *
  296. *       /K - Keyword.      }
  297. *       /A - Required.     }  handled by dos
  298. *       /F - Rest of line. }
  299. *
  300. *   INPUTS
  301. *       arguments - the string to be parsed
  302. *       template  - dos.library/ReadArgs()-style like template
  303. *       stem      - stem prefix for resulting variables (optional)
  304. *
  305. *       For /T arguments the corresponding variable (see RESULTS) is read
  306. *       to get the default.  The variable must be either false (0) or true
  307. *       (1).  If the variable does not exist, the default is false (0).
  308. *
  309. *   RESULT
  310. *       okay  - boolean value indicating success.
  311. *
  312. *       RC (rexx variable) - contains the dos error code if the
  313. *               function was not successfull. This can can directly
  314. *               be used as input for Fault().
  315. *
  316. *       For each item in the template which has a corresponding
  317. *       argument, a Rexx variable will be created. The variable's
  318. *       name is the item's name prefixed by the stem name (if given). If
  319. *       an item name has synonyms, the first one will be taken as variable
  320. *       name.
  321. *
  322. *       Items with option /M will result in a stem variable with a
  323. *       .COUNT node containing the number of elements. If no fitting
  324. *       arguments is passed, .COUNT will be zero.
  325. *       The entries will be in stem nodes .0 to .n (where n is
  326. *       .COUNT-1).
  327. *
  328. *   EXAMPLE
  329. *       /* ReadArgsExample.rexx */
  330. *       If ~show('L', 'rexxdossupport.library') then do
  331. *         if ~addlib('rexxdossupport.library', 0, -30, 2) then do
  332. *          say "rexxdossupport.library not available, exiting ..."
  333. *          exit 20
  334. *         end
  335. *       end
  336. *
  337. *       parse arg args /* get the arguments w/o ARexx-Parsing */
  338. *
  339. *       template = "Files/M,Method/K,MinSize/K/N,Test/S,Toggle/T"
  340. *
  341. *       /* set defaults */
  342. *       Method = "NUKE"; MinSize = 512;
  343. *
  344. *       /* no stem given: results are assigned to simple variables */
  345. *
  346. *       if ReadArgs(args,template) then
  347. *         say 'Method='method ' MinSize='MinSize 'Test=' test 'Toggle='toggle
  348. *         do i = 0 by 1 for files.count
  349. *           say files.i
  350. *         end
  351. *
  352. *       /* stem given: results are assigned to stem variable */
  353. *       /* since the default values are set as non-stem variables,
  354. *        * they are not overwritten by the following call even if
  355. *        * given
  356. *        */
  357. *
  358. *       drop method MinSize test /*toggle is kept! */
  359. *
  360. *       if ReadArgs(args,template,"args.") then
  361. *         say 'Method ='args.method 'MinSize='args.MinSize
  362. *         say 'Test=' args.test 'Toggle='args.toggle
  363. *         do i = 0 by 1 for args.files.count
  364. *           say args.files.i
  365. *         end
  366. *
  367. *   NOTE
  368. *      /T was unsupported till V 3.1
  369. *
  370. *   NOTE
  371. *      Some background about /T which is not documented well:
  372. *      /T acts very like /S but may be set to on/off using the keywords
  373. *      'YES'/'ON' and 'NO'/'OFF'. This is usefull when parsing eg.
  374. *      tool-types or using multible option-sources (eg. defaults taken
  375. *      from an environment variable).
  376. *
  377. *                                  /S             /T
  378. *        1st option-set          UseScreen     UseScreen=YES
  379. *        2nd option-set        NoUseScreen     UseScreen=NO
  380. *          --> results into   ??confusion??    UseScreen=NO
  381. *
  382. *   SEE ALSO
  383. *      Fault(), dos.library/ReadArgs()
  384. *
  385. ***********************)
  386.  
  387. PROCEDURE ReadArgs (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  388.  
  389.   TYPE ArgsArray = UNTRACED POINTER TO ARRAY d.maxMultiArgs+1 OF LONGINT;
  390.  
  391.   PROCEDURE CreateSTEM (msg: rx.RexxMsgPtr;
  392.                         template: e.LSTRPTR;
  393.                         resarray: ArgsArray;
  394.                         stembase: e.STRPTR;
  395.                         setDefaultsFromRexxVars: BOOLEAN): INTEGER;
  396.   VAR
  397.     synonym, result, rs, rb, t, wordCnt: INTEGER;
  398.     opts, optn, optm, optt: BOOLEAN;
  399.     longbuff: rls.ConvertLongBuffer;
  400.     resb: ARRAY 512 OF CHAR;
  401.  
  402.     PROCEDURE SetValue (VAR value: LONGINT): INTEGER;
  403.     VAR
  404.       string: e.LSTRPTR;
  405.     BEGIN
  406.       IF optt THEN    (*$RangeChk-*)
  407.         result := SHORT(rvi.GetRexxVar(msg,resb,string)); (*$RangeChk=*)
  408.         IF result # rx.ok THEN RETURN result END;
  409.         value := d.DOSFALSE;
  410.         IF string # NIL THEN
  411.           IF d.StrToLong(string^,value) < 0 THEN RETURN arithConvertionErr END;
  412.           CASE value OF
  413.           |0: (*value := d.DOSFALSE;  alredy set *)
  414.           |1: value := d.DOSTRUE;
  415.           ELSE RETURN arithConvertionErr
  416.           END;
  417.         END;
  418.       END;
  419.       RETURN rx.ok;
  420.     END SetValue;
  421.  
  422.     PROCEDURE GetValue (value: LONGINT): INTEGER;
  423.     VAR
  424.       string: e.LSTRPTR;
  425.     BEGIN
  426.       IF opts OR optt THEN
  427.         IF value = d.DOSFALSE THEN string := y.ADR(strFALSE);
  428.                               ELSE string := y.ADR(strTRUE);  END;
  429.       ELSIF optn THEN (* numerisch *)
  430.         pf.OSPrintF(longbuff, "%ld", y.VAL(ArgsArray,value)[0]);
  431.         string := y.ADR(longbuff);
  432.       ELSE (* string *)
  433.         string := y.VAL(e.LSTRPTR,value);
  434.       END;                                                                (*$RangeChk-*)
  435.       RETURN SHORT(rvi.SetRexxVar(msg,resb,string^,str.Length(string^))); (*$RangeChk=*)
  436.     END GetValue;
  437.  
  438.     PROCEDURE CreateResultList(value: ArgsArray): INTEGER;
  439.     VAR
  440.       index: LONGINT;
  441.       tt: e.STRPTR;
  442.       result: INTEGER;
  443.     BEGIN
  444.       tt := y.ADR(resb[t]);
  445.       index := 0;
  446.       IF value # NIL THEN
  447.         WHILE value[index] # NIL DO
  448.           pf.OSPrintF( tt^, ".%ld", index); (* Index an den Stem-Namen anhängen *)
  449.           result := GetValue(value[index]);
  450.           IF result # 0 THEN RETURN result; END;
  451.           INC(index);
  452.         END;
  453.       END;
  454.       tt^ := ".COUNT"; (* Die Count-Node ausfüllen *)
  455.       pf.OSPrintF( longbuff, "%ld", index );                                (*$RangeChk-*)
  456.       RETURN SHORT(rvi.SetRexxVar(msg,resb,longbuff,str.Length(longbuff))); (*$RangeChk=*)
  457.     END CreateResultList;
  458.  
  459.   BEGIN
  460.     wordCnt := 0; result := rx.ok;
  461.     IF stembase # NIL THEN (* Präfix einbauen *)
  462.       COPY(stembase^,resb); rb := SHORT(str.Length(resb));
  463.       str.Upper(resb);
  464.     ELSE
  465.       resb := ""; rb := 0;
  466.     END;
  467.     rs := 0;
  468.  
  469.     (* Liste aufbauen *)
  470.     WHILE template[rs] # CHR(0) DO
  471.       t := rb; optn := FALSE; optm := FALSE; opts := FALSE; optt := FALSE; synonym := -1;
  472.       LOOP
  473.         CASE template[rs] OF
  474.         | CHR(0): EXIT;
  475.         | ",": INC(rs); EXIT;
  476.         | "=": synonym := t;
  477.         | "/":
  478.           INC(rs);
  479.           CASE CAP(template[rs]) OF
  480.           | "N": optn := TRUE;
  481.           | "M": optm := TRUE;
  482.           | "S": opts := TRUE;
  483.           | "T": optt := TRUE;
  484.           ELSE END;
  485.         ELSE
  486.           resb[t] := CAP(template[rs]); INC(t); (* Resultatnamen kopieren *)
  487.         END;
  488.         INC(rs);
  489.       END;
  490.       IF synonym >= 0 THEN t := synonym; END;
  491.       resb[t] := CHR(0);
  492.       IF opts OR optt THEN
  493.         optm := FALSE; optn := FALSE; END;
  494.  
  495.       (* hier ist nun der Basisname der Stem-Variable in resb,
  496.        * und t zeigt in resb auf die Stelle, an der nun ggf. die
  497.        * Stem-Erweiterungen (.COUNT, .0 - .n) angehängt werden
  498.        *)
  499.       IF setDefaultsFromRexxVars THEN
  500.         result := SetValue(resarray[wordCnt]);
  501.       ELSIF optm THEN (* /M war im Namen, also Liste *)
  502.         result := CreateResultList(y.VAL(ArgsArray,resarray[wordCnt]));
  503.       ELSE (* keine Liste *)
  504.         IF opts OR optt OR (resarray[wordCnt] # NIL) THEN
  505.           result := GetValue(resarray[wordCnt]);
  506.         END;
  507.       END;
  508.       IF result # rx.ok THEN RETURN result; END;
  509.       INC(wordCnt);
  510.     END;
  511.     RETURN result;
  512.   END CreateSTEM;
  513.  
  514. VAR
  515.   hasOptT: BOOLEAN;
  516.  
  517.   PROCEDURE ScanArgs(template: ARRAY OF CHAR): LONGINT; (* $CopyArrays- *)
  518.   VAR
  519.     pos, numArgs: LONGINT;
  520.   BEGIN
  521.     numArgs := 1; pos := 0;
  522.     WHILE pos < LEN(template) DO
  523.       CASE template[pos] OF
  524.       |0X:  RETURN numArgs;
  525.       |",": INC(numArgs);
  526.       |"/": IF template[pos+1] = "T" THEN hasOptT := TRUE END;
  527.       ELSE END;
  528.       INC(pos);
  529.     END;
  530.     RETURN numArgs;
  531.   END ScanArgs;
  532.  
  533. CONST
  534.   rdArgsDefault = d.RDArgs(NIL,0,0, 0, NIL,0,NIL,LONGSET{d.noPrompt});
  535.   argInput = 1; argTemplate = 2; argStem = 3;
  536. VAR
  537.   argv: UNTRACED POINTER TO d.ArgsStruct;
  538.   arguments, rdArgs: d.RDArgsPtr;
  539.   i: LONGINT;
  540.   retval: INTEGER;
  541.   input: e.LSTRPTR;
  542. BEGIN (* ReadArgs *)
  543.   IF ~ rls.ArgsPresent(msg,1,2) THEN RETURN invalidArg; END;
  544.   IF (rx.ActionArg(msg.action) < argStem) THEN msg.args[argStem] := NIL; END;
  545.   retval := noMemory;
  546.   i := rxs.LengthArgstring(msg.args[argInput]);
  547.   input := rxs.CreateArgstring(msg.args[argInput]^,i+1);
  548.   IF input # NIL THEN
  549.     input[i] := CHR(0AH); (* LineFeed, needed for ReadArgs() *)
  550.  
  551.     hasOptT := FALSE;
  552.     i := ScanArgs(msg.args[argTemplate]^);
  553.  
  554.     rdArgs := d.AllocDosObject(d.rdArgs,NIL);
  555.     IF rdArgs # NIL THEN
  556.       ol.Allocate(argv, i *SIZE(e.APTR));
  557.       IF argv # NIL THEN
  558.         rdArgs^ := rdArgsDefault;
  559.         rdArgs.source.buffer := y.ADR(input^);
  560.         rdArgs.source.length := rxs.LengthArgstring(input);
  561.  
  562.         IF hasOptT THEN
  563.           retval := CreateSTEM(msg, msg.args[argTemplate],
  564.                                y.VAL(ArgsArray,argv),
  565.                                y.VAL(e.STRPTR,msg.args[argStem]),
  566.                                TRUE);
  567.         END;
  568.  
  569.         arguments := d.ReadArgs(msg.args[argTemplate]^,argv^,rdArgs);
  570.         IF arguments = NIL THEN
  571.           resultStr := rxs.CreateArgstring(strFALSE,1);
  572.           retval := rls.SetRC(msg,d.IoErr());
  573.         ELSE
  574.           resultStr := rxs.CreateArgstring(strTRUE,1);
  575.           retval := CreateSTEM(msg, msg.args[argTemplate],
  576.                                y.VAL(ArgsArray,argv),
  577.                                y.VAL(e.STRPTR,msg.args[argStem]),
  578.                                FALSE);
  579.           d.FreeArgs(arguments);
  580.         END;
  581.         IF resultStr = NIL THEN retval := noMemory; END;
  582.         DISPOSE(argv);
  583.       END;
  584.       d.FreeDosObject(d.rdArgs,rdArgs);
  585.     END;
  586.     rxs.DeleteArgstring(input);
  587.   END;
  588.   RETURN retval;
  589. END ReadArgs;
  590.  
  591. (* ---------------------------------------------------------------- *)
  592.  
  593. PROCEDURE CheckBinaryVar (msg: rx.RexxMsgPtr;
  594.                           argNum: INTEGER;
  595.                           VAR flags: LONGSET): BOOLEAN;
  596. VAR
  597.   isBin: BOOLEAN;
  598. BEGIN
  599.   IF rls.IsValidArg(msg,argNum,"B",isBin) THEN
  600.     IF isBin THEN
  601.       flags := flags + LONGSET{d.binaryVar,d.dontNullTerm};
  602.     END;
  603.     RETURN TRUE;
  604.   ELSE
  605.     RETURN FALSE;
  606.   END;
  607. END CheckBinaryVar;
  608.  
  609. PROCEDURE CheckLocalGlobal (msg: rx.RexxMsgPtr;
  610.                             argNum: INTEGER;
  611.                             VAR flags: LONGSET): BOOLEAN;
  612. BEGIN
  613.   IF (rx.ActionArg(msg.action) >= argNum) & (msg.args[argNum] # NIL) THEN
  614.     CASE CAP(msg.args[argNum][0]) OF
  615.     |"G": INCL(flags,d.globalOnly);
  616.     |"L": INCL(flags,d.localOnly);
  617.     ELSE
  618.       RETURN FALSE;
  619.     END;
  620.   END;
  621.   RETURN TRUE;
  622. END CheckLocalGlobal;
  623.  
  624. (****** rexxdossupport.library/GetVar *******************
  625. *
  626. *   NAME
  627. *       GetVar -- Returns the value of a local or global variable
  628. *
  629. *   SYNOPSIS
  630. *       string = GetVar( name, ["Local" | "Global"], ["Binary"] )
  631. *
  632. *   FUNCTION
  633. *       Gets the value of a local or environment variable.  It is advised to
  634. *       only use ASCII strings inside variables, but not required.  This stops
  635. *       putting characters into the destination when a \n is hit, unless
  636. *       "Binary" is specified.  (The \n is not stored in the buffer.)
  637. *
  638. *   INPUTS
  639. *       name     - variable name.
  640. *       "Global" - tries to get a global env variable.
  641. *       "Local"  - tries to get a local variable (see note below).
  642. *       "Binary" - don't stop at \n
  643. *                  in this mode the string returned is not null terminated
  644. *
  645. *                The default is to try to get a local variable first,
  646. *                then to try to get a global environment variable.
  647. *
  648. *   RESULT
  649. *       string - contents of the variable
  650. *
  651. *       RC (rexx variable) - 5 when variable does not exist,
  652. *                            0 otherwise
  653. *
  654. *   EXAMPLE
  655. *       /* */
  656. *       username = GetVar("username")
  657. *       if RC = 5 then
  658. *         say "Variable 'username' is not set"
  659. *       else
  660. *         say "Variable 'username' is" username
  661. *
  662. *   NOTES
  663. *      Contents may be max. 512 char.
  664. *
  665. *      Since ARexx spawns a new process of each script -- even if
  666. *      started from Shell -- option "Local" may not work as supposed.
  667. *      But one can
  668. *
  669. *                       |  Callie may  |  Callie may
  670. *        Calling order  |     read     |     write
  671. *                       | callers vars | to callers vars
  672. *       ----------------+--------------+-------------------
  673. *        Shell -> Arexx |      no      |      no
  674. *        ARexx -> Shell |     yes      |      no
  675. *        ARexx -> Arexx |      no      |      no
  676. *
  677. *   BUGS
  678. *       Due to a bug in dos.library, binary global vars will be null
  679. *       terminated in V37, V38.
  680. *
  681. *   SEE ALSO
  682. *     SetVar(), DeleteVar(), dos.library/GetVar()
  683. *
  684. **********************)
  685.  
  686. PROCEDURE GetVar (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  687. VAR
  688.   flags: LONGSET;
  689.   len: LONGINT;
  690.   res: INTEGER;
  691.   buffer: ARRAY 512 OF CHAR;
  692. CONST
  693.   argName = 1; argLocGlob = 2; argBinary = 3;
  694. BEGIN
  695.   flags := LONGSET{};
  696.   IF ~ CheckLocalGlobal(msg,argLocGlob,flags)
  697.   OR ~ CheckBinaryVar(msg,argBinary,flags)
  698.   OR (msg.args[argName] = NIL) THEN
  699.     RETURN invalidArg;
  700.   END;
  701.   len := d.GetVar(msg.args[argName]^,buffer,SIZE(buffer),flags);
  702.   IF len < 0 THEN
  703.     RETURN rls.SetRC5(msg);
  704.   END;
  705.   IF (len > SIZE(buffer)-1) & (len # d.IoErr()) THEN
  706.     RETURN stringTooLong;
  707.   END;
  708.   resultStr := rxs.CreateArgstring(buffer,len);
  709.   IF resultStr = NIL THEN RETURN noMemory; END;
  710.   RETURN rls.SetRC0(msg);
  711. END GetVar;
  712.  
  713.  
  714. (****** rexxdossupport.library/SetVar *******************
  715. *
  716. *   NAME
  717. *       SetVar -- Sets a local or environment variable
  718. *
  719. *   SYNOPSIS@{ub}
  720. *       success = SetVar( name, ["Local" | "Global"] )
  721. *
  722. *   FUNCTION
  723. *       Sets a local or environment variable.  It is advised to only use
  724. *       ASCII strings inside variables, but not required.
  725. *
  726. *   INPUTS
  727. *       name     - variable name.
  728. *       "Global" - tries to get a global env variable.
  729. *       "Local"  - tries to get a local variable (see note below).
  730. *
  731. *               The default is to set a local environment variable.
  732. *
  733. *   RESULT
  734. *       success - If non-zero, the variable was sucessfully set, FALSE
  735. *                 indicates failure.
  736. *
  737. *   NOTES
  738. *      Since ARexx spawn a new process of each script -- even if
  739. *      started from Shell -- option "Local" may not work as supposed.
  740. *
  741. *   SEE ALSO
  742. *     GetVar(), DeleteVar(), dos.library/SetVar()
  743. *
  744. **************************)
  745.  
  746. PROCEDURE SetVar (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  747. VAR
  748.   flags: LONGSET;
  749. CONST
  750.   argName = 1; argContents = 2; argLocGlob = 3;
  751. BEGIN
  752.   flags := LONGSET{};
  753.   IF ~ CheckLocalGlobal(msg,argLocGlob,flags)
  754.   OR (msg.args[argName] = NIL) THEN
  755.     RETURN invalidArg;
  756.   END;
  757.   IF d.SetVar(msg.args[argName]^,msg.args[argContents]^,
  758.               rxs.LengthArgstring(msg.args[argContents]),flags) THEN
  759.     resultStr := rxs.CreateArgstring(strTRUE,1);
  760.   ELSE
  761.     resultStr := rxs.CreateArgstring(strFALSE,1);
  762.   END;
  763.   IF resultStr = NIL THEN RETURN noMemory; END;
  764.   RETURN rx.ok;
  765. END SetVar;
  766.  
  767.  
  768. (****** rexxdossupport.library/DeleteVar *******************
  769. *
  770. *   NAME
  771. *       DeleteVar -- Deletes a local or environment variable
  772. *
  773. *   SYNOPSIS
  774. *       success = DeleteVar( name, [ "Local" | "Global" ] )
  775. *
  776. *   FUNCTION
  777. *       Deletes a local or environment variable.
  778. *
  779. *   INPUTS
  780. *       name     - variable name.  Note variable names follow
  781. *                  filesystem syntax and semantics.
  782. *       "Global" - tries to get a global env variable.
  783. *       "Local"  - tries to get a local variable (see note below).
  784. *
  785. *                The default is to delete a local variable if found, otherwise
  786. *                a global environment variable if found.
  787. *
  788. *   RESULT
  789. *       success - If TRUE, the variable was sucessfully deleted,
  790. *                 FALSE indicates failure.
  791. *
  792. *   NOTES
  793. *      Since ARexx spawn a new process of each script -- even if
  794. *      started from Shell -- option "Local" may not work as supposed.
  795. *
  796. *   SEE ALSO
  797. *       GetVar(), SetVar(), dos.library/DeleteVar()
  798. *
  799. ***********************)
  800.  
  801. PROCEDURE DeleteVar (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  802. VAR
  803.   flags: LONGSET;
  804. CONST
  805.   argName = 1; argLocGlob = 2;
  806. BEGIN
  807.   flags := LONGSET{};
  808.   IF ~ CheckLocalGlobal(msg,argLocGlob,flags)
  809.   OR (msg.args[argName] = NIL) THEN
  810.     RETURN invalidArg;
  811.   END;
  812.   IF d.DeleteVar(msg.args[argName]^,flags) THEN
  813.     resultStr := rxs.CreateArgstring(strTRUE,1);
  814.   ELSE
  815.     resultStr := rxs.CreateArgstring(strFALSE,1);
  816.   END;
  817.   IF resultStr = NIL THEN RETURN noMemory; END;
  818.   RETURN rx.ok;
  819. END DeleteVar;
  820.  
  821. (* ---------------------------------------------------------------- *)
  822.  
  823. (****** rexxdossupport.library/Fault *******************
  824. *
  825. *   NAME
  826. *       Fault -- Returns the text associated with a DOS error code
  827. *
  828. *   SYNOPSIS
  829. *       string = Fault( code, header )
  830. *
  831. *   FUNCTION
  832. *       This routine obtains the error message text for the given
  833. *       error code. The header is prepended to the text of the error
  834. *       message, followed by a colon. By convention, error messages
  835. *       should be no longer than 80 characters, and preferably no
  836. *       more than 60.
  837. *
  838. *       The value returned by IoErr() (not available in this library)
  839. *       is set to the code passed in. If there is no message for the
  840. *       error code, the message will be "Error code <number>\n".
  841. *
  842. *       The string will be empty if the code passed in was 0.
  843. *
  844. *   INPUTS
  845. *       code   - Error code
  846. *       header - header to output before error text
  847. *
  848. *   RESULT
  849. *       string - error massage as described above.
  850. *
  851. *       RC (rexx variable) - 5 when error message is empty
  852. *                            0 otherwise
  853. *
  854. *   BUGS
  855. *      I've been told that this function returns only an empty sting.
  856. *      Since nobody gave me further information, I can't fix it.
  857. *
  858. *   SEE ALSO
  859. *       dos.library/Fault(), dos.library/IoErr()
  860. *
  861. *****************************)
  862.  
  863. PROCEDURE Fault (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  864. CONST
  865.   argNumber = 1; argHeader = 2;
  866. VAR
  867.   errCode, len: LONGINT;
  868.   retval: INTEGER;
  869.   buffer: ARRAY 512 OF CHAR; (* should be enough *)
  870. BEGIN
  871.   IF (msg.args[argNumber] = NIL) THEN RETURN invalidArg; END;
  872.   retval := rx.ok;
  873.   IF (rx.ActionArg(msg.action) < argHeader) THEN
  874.     msg.args[argHeader] := NIL; END;
  875.   len := d.StrToLong(msg.args[argNumber]^, errCode);
  876.   IF len # str.Length(msg.args[argNumber]^) THEN
  877.     RETURN invalidArg; END;
  878.   (* $NilChk-   avoid trapping msg.args[argHeader]^ *)
  879.   len := d.Fault(errCode, msg.args[argHeader]^, buffer, SIZE(buffer));
  880.   (* $NilChk= *)
  881.   IF len = 0 THEN
  882.     retval := rls.SetRC5(msg);
  883.   ELSE
  884.     retval := rls.SetRC0(msg);
  885.     resultStr := rxs.CreateArgstring(buffer,str.Length(buffer));
  886.     IF resultStr = NIL THEN RETURN noMemory; END;
  887.   END;
  888.   RETURN retval
  889. END Fault;
  890.  
  891. (* ---------------------------------------------------------------- *)
  892.  
  893. (****** rexxdossupport.library/MatchPattern *******************
  894. *
  895. *   NAME
  896. *       MatchPattern --  Checks for a pattern match with a string
  897. *
  898. *   SYNOPSIS
  899. *       match = MatchPattern(pattern, string, ["Nocase"], ["Parsed"] )
  900. *
  901. *   FUNCTION
  902. *       Checks for a pattern match with a string.
  903. *       This routine is case-sensitive by default. Use option
  904. *       "NoCase" for case-insensitve matching.
  905. *
  906. *       Use option "Parsed" to indicate that pattern has already been
  907. *       tokenized using ParsePattern(). Make sure to use or use not
  908. *       "NoCase" for both function.
  909. *
  910. *   INPUTS
  911. *       pattern  - pattern string to match
  912. *       string   - string to match against given pattern
  913. *       "Nocase" - match should be case-insensitve
  914. *       "Parsed" - pattern has already been parsed using ParsePattern()
  915. *
  916. *   RESULT
  917. *       match - success or failure of pattern match.
  918. *
  919. *   SEE ALSO
  920. *       ParsePattern(), dos.library/MatchPattern(),
  921. *       dos.library/MatchPatternNoCase()
  922. *
  923. ***********************)
  924.  
  925. PROCEDURE MatchPattern (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  926. VAR
  927.   buffer: e.LSTRPTR;
  928.   res, noCase, isParsed: BOOLEAN;
  929.   bufferLen: LONGINT;
  930. CONST
  931.   argPattern = 1; argInput = 2; argNoCase = 3; argIsParsed = 4;
  932. BEGIN
  933.   IF ~ rls.IsValidArg(msg,argNoCase,"N",noCase)
  934.   OR ~ rls.IsValidArg(msg,argIsParsed,"P",isParsed)
  935.   OR ~ rls.ArgsPresent(msg,argPattern,argInput) THEN
  936.     RETURN invalidArg; END;
  937.  
  938.   IF isParsed THEN
  939.     buffer := msg.args[argPattern];
  940.     res := TRUE;
  941.   ELSE
  942.     bufferLen := 2 * str.Length(msg.args[argPattern]^) +2;
  943.     ol.Allocate(buffer,bufferLen);
  944.     IF buffer = NIL THEN
  945.       RETURN noMemory;
  946.     END;
  947.     IF noCase THEN
  948.       res := (d.ParsePatternNoCase(msg.args[argPattern]^,buffer^,bufferLen) >= 0);
  949.     ELSE
  950.       res := (d.ParsePattern(msg.args[argPattern]^,buffer^,bufferLen) >= 0);
  951.     END;
  952.     IF ~ res THEN
  953.       DISPOSE(buffer);
  954.       RETURN invalidTemplate;
  955.     END;
  956.   END;
  957.  
  958.   IF noCase THEN res := d.MatchPatternNoCase(buffer^,msg.args[argInput]^);
  959.             ELSE res := d.MatchPattern(buffer^,msg.args[argInput]^); END;
  960.  
  961.   IF ~ isParsed THEN DISPOSE(buffer); END;
  962.  
  963.   IF ~ res THEN
  964.     IF d.IoErr() = 0 THEN
  965.       resultStr := rxs.CreateArgstring(strFALSE,1);
  966.       IF resultStr = NIL THEN RETURN noMemory; END;
  967.       RETURN rx.ok;
  968.     ELSE
  969.       RETURN nestingLevel;
  970.     END;
  971.   ELSE
  972.     resultStr := rxs.CreateArgstring(strTRUE,1);
  973.     IF resultStr = NIL THEN RETURN noMemory; END;
  974.     RETURN rx.ok;
  975.   END;
  976. END MatchPattern;
  977.  
  978.  
  979. (****** rexxdossupport.library/ParsePattern *******************
  980. *
  981. *   NAME
  982. *       ParsePattern -- Create a tokenized string for MatchPattern()
  983. *
  984. *   SYNOPSIS
  985. *       token = ParsePattern( pattern, ["NoCase"] )
  986. *
  987. *   FUNCTION
  988. *       Tokenizes a pattern, for use by MatchPattern().  Also indicates
  989. *       if there are any wildcards in the pattern (i.e. whether it might match
  990. *       more than one item).
  991. *
  992. *       For a description of the wildcards, see dos.library/ParsePattern().
  993. *
  994. *   INPUTS
  995. *       pattern  - unparsed wildcard string to search for.
  996. *
  997. *   RESULT
  998. *       token    - output string, tokenized version of input.
  999. *
  1000. *       RC (rexx variable) - 5 when does not contain wildcards
  1001. *                            0 otherwise
  1002. *
  1003. *   BUGS
  1004. *       Since is't not clear wether the resulting token may contain
  1005. *       null charakters, the returned string is always
  1006. *       2 * Length(pattern) + 2 bytes long.
  1007. *
  1008. *   SEE ALSO
  1009. *       ParsePattern(), dos.library/ParsePattern(),
  1010. *       dos.library/ParsePatternNoCase()
  1011. *
  1012. *********************)
  1013.  
  1014. PROCEDURE ParsePattern (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1015. VAR
  1016.   result: INTEGER;
  1017.   noCase: BOOLEAN;
  1018.   buffer: e.LSTRPTR;
  1019.   bufferLen: LONGINT;
  1020. CONST
  1021.   argPattern = 1; argNoCase = 2;
  1022. BEGIN
  1023.   IF ~ rls.IsValidArg(msg,argNoCase,"N",noCase)
  1024.   OR (msg.args[argPattern] = NIL) THEN
  1025.     RETURN invalidArg; END;
  1026.   bufferLen := 2 * str.Length(msg.args[argPattern]^) +2;
  1027.   ol.Allocate(buffer,bufferLen);
  1028.   IF buffer = NIL THEN
  1029.     RETURN noMemory;
  1030.   END;
  1031.   IF noCase THEN
  1032.     result := d.ParsePatternNoCase(msg.args[argPattern]^,buffer^,bufferLen)
  1033.   ELSE
  1034.     result := d.ParsePattern(msg.args[argPattern]^,buffer^,bufferLen);
  1035.   END;
  1036.   IF result < 0 THEN
  1037.     result := invalidTemplate;
  1038.   ELSE
  1039.     resultStr := rxs.CreateArgstring(buffer^,str.Length(buffer^));
  1040.     IF resultStr = NIL THEN
  1041.       result := noMemory;
  1042.     ELSIF result > 0 THEN
  1043.       result := rls.SetRC0(msg);
  1044.     ELSE
  1045.       result := rls.SetRC5(msg);
  1046.     END;
  1047.   END;
  1048.   DISPOSE(buffer);
  1049.   RETURN result;
  1050. END ParsePattern;
  1051.  
  1052. (* ---------------------------------------------------------------- *)
  1053.  
  1054. (****** rexxdossupport.library/Delete *******************
  1055. *
  1056. *   NAME
  1057. *       Delete -- Delete a file or directory (V2)
  1058. *
  1059. *   SYNOPSIS
  1060. *       success = Delete( name )
  1061. *
  1062. *   FUNCTION
  1063. *       This attempts to delete the file or directory specified by
  1064. *       'name'. If the deletion fails an error is returned and the
  1065. *       rexx variable RC is set. Note that all the files within a
  1066. *       directory must be deleted before the directory itself can be
  1067. *       deleted.
  1068. *
  1069. *   INPUTS
  1070. *       name     - name of file or directory to delete.
  1071. *
  1072. *   RESULT
  1073. *       success - If TRUE, the file was sucessfully deleted,
  1074. *                 FALSE indicates failure.
  1075. *
  1076. *       RC (rexx variable) - contains the dos error code if the
  1077. *               function was not successfull. This can can directly
  1078. *               be used as input for Fault().
  1079. *
  1080. *   SEE ALSO
  1081. *       Fault(), dos.library/DeleteFile()
  1082. *
  1083. ****************************)
  1084.  
  1085. PROCEDURE Delete (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1086. CONST
  1087.   argName = 1;
  1088. VAR
  1089.   retval: INTEGER;
  1090. BEGIN
  1091.   IF msg.args[argName] = NIL THEN RETURN invalidArg; END;
  1092.   retval := rx.ok;
  1093.   IF d.DeleteFile(msg.args[argName]^) THEN
  1094.     resultStr := rxs.CreateArgstring(strTRUE,1);
  1095.   ELSE
  1096.     resultStr := rxs.CreateArgstring(strFALSE,1);
  1097.     retval := rls.SetRC(msg,d.IoErr());
  1098.   END;
  1099.   IF resultStr = NIL THEN retval := noMemory; END;
  1100.   RETURN retval;
  1101. END Delete;
  1102.  
  1103. (****** rexxdossupport.library/Rename *******************
  1104. *
  1105. *   NAME
  1106. *       Rename -- Rename a directory or file (V2)
  1107. *
  1108. *   SYNOPSIS
  1109. *       success = Rename( oldName, newName )
  1110. *
  1111. *   FUNCTION
  1112. *       Rename() attempts to rename the file or directory specified
  1113. *       as 'oldName' with the name 'newName'. If the file or
  1114. *       directory 'newName' exists, Rename() fails and returns an
  1115. *       error. Both 'oldName' and the 'newName' can contain a
  1116. *       directory specification. In this case, the file will be moved
  1117. *       from one directory to another.
  1118. *
  1119. *       Note: it is impossible to Rename() a file from one volume to
  1120. *       another.
  1121. *
  1122. *   INPUTS
  1123. *       oldName - pointer to a null-terminated string
  1124. *       newName - pointer to a null-terminated string
  1125. *
  1126. *   RESULT
  1127. *       success - If TRUE, the variable was sucessfully deleted,
  1128. *                 FALSE indicates failure.
  1129. *
  1130. *       RC (rexx variable) - contains the dos error code if the
  1131. *               function was not successfull. This can can directly
  1132. *               be used as input for Fault().
  1133. *
  1134. *   SEE ALSO
  1135. *       Fault(), dos.library/Rename()
  1136. *
  1137. ***************************)
  1138.  
  1139. PROCEDURE Rename (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1140. VAR
  1141.   retval: INTEGER;
  1142. CONST
  1143.   argFrom = 1; argTo = 2;
  1144. BEGIN
  1145.   IF ~ rls.ArgsPresent(msg,argFrom,argTo) THEN RETURN invalidArg; END;
  1146.   retval := rx.ok;
  1147.   IF d.Rename(msg.args[argFrom]^, msg.args[argTo]^) THEN
  1148.     resultStr := rxs.CreateArgstring(strTRUE,1);
  1149.   ELSE
  1150.     resultStr := rxs.CreateArgstring(strFALSE,1);
  1151.     retval := rls.SetRC(msg,d.IoErr());
  1152.   END;
  1153.   IF resultStr = NIL THEN retval := noMemory; END;
  1154.   RETURN retval;
  1155. END Rename;
  1156.  
  1157. (****** rexxdossupport.library/MakeDir *******************
  1158. *
  1159. *   NAME
  1160. *       MakeDir -- Create a new directory (V2)
  1161. *
  1162. *   SYNOPSIS
  1163. *       success = MakeDir( name )
  1164. *
  1165. *   FUNCTION
  1166. *       MakeDir creates a new directory with the specified name. If
  1167. *       it fails an error is returned and the rexx variable RC is
  1168. *       set.  Directories can only be created on devices which
  1169. *       support them, e.g. disks.
  1170. *
  1171. *   INPUTS
  1172. *       name     - name of directory to create
  1173. *
  1174. *   RESULT
  1175. *       success - If TRUE, the variable was sucessfully deleted,
  1176. *                 FALSE indicates failure.
  1177. *
  1178. *       RC (rexx variable) - contains the dos error code if the
  1179. *               function was not successfull. This can can directly
  1180. *               be used as input for Fault().
  1181. *
  1182. *   SEE ALSO
  1183. *       Fault(), dos.library/CreateDir()
  1184. *
  1185. **************************)
  1186.  
  1187. PROCEDURE MakeDir (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1188. VAR
  1189.   retval: INTEGER;
  1190. CONST
  1191.   argName = 1;
  1192. VAR
  1193.   dir: d.FileLockPtr;
  1194. BEGIN
  1195.   IF msg.args[argName] = NIL THEN RETURN invalidArg; END;
  1196.   retval := rx.ok;
  1197.   dir := d.CreateDir(msg.args[argName]^);
  1198.   IF dir # NIL THEN
  1199.     d.UnLock(dir);
  1200.     resultStr := rxs.CreateArgstring(strTRUE,1);
  1201.   ELSE
  1202.     resultStr := rxs.CreateArgstring(strFALSE,1);
  1203.     retval := rls.SetRC(msg,d.IoErr());
  1204.   END;
  1205.   IF resultStr = NIL THEN retval := noMemory; END;
  1206.   RETURN retval;
  1207. END MakeDir;
  1208.  
  1209. (****** rexxdossupport.library/SetComment *******************
  1210. *
  1211. *   NAME
  1212. *       SetComment -- Change a files' comment string (V2)
  1213. *
  1214. *   SYNOPSIS
  1215. *       success = SetComment( name, comment )
  1216. *
  1217. *   FUNCTION
  1218. *       SetComment() sets a comment on a file or directory. The
  1219. *       comment may be up to 80 characters in the current ROM
  1220. *       filesystem (and RAM:).  Note that not all filesystems will
  1221. *       support comments (for example, NFS usually will not), or the
  1222. *       size of comment supported may vary.
  1223. *
  1224. *   INPUTS
  1225. *       name     - name of file or directory to set comment
  1226. *       comment  - comment to be set
  1227. *
  1228. *   RESULT
  1229. *       success - If TRUE, the variable was sucessfully deleted,
  1230. *                 FALSE indicates failure.
  1231. *
  1232. *       RC (rexx variable) - contains the dos error code if the
  1233. *               function was not successfull. This can can directly
  1234. *               be used as input for Fault().
  1235. *
  1236. *   SEE ALSO
  1237. *       SetProtection(), Fault(), dos.library/SetComment()
  1238. *
  1239. **************************)
  1240.  
  1241. PROCEDURE SetComment (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1242. VAR
  1243.   retval: INTEGER;
  1244. CONST
  1245.   argFile = 1; argComment = 2;
  1246. BEGIN
  1247.   IF ~ rls.ArgsPresent(msg,argFile,argComment) THEN RETURN invalidArg; END;
  1248.   retval := rx.ok;
  1249.   IF d.SetComment(msg.args[argFile]^, msg.args[argComment]^) THEN
  1250.     resultStr := rxs.CreateArgstring(strTRUE,1);
  1251.   ELSE
  1252.     resultStr := rxs.CreateArgstring(strFALSE,1);
  1253.     retval := rls.SetRC(msg,d.IoErr());
  1254.   END;
  1255.   IF resultStr = NIL THEN retval := noMemory; END;
  1256.   RETURN retval;
  1257. END SetComment;
  1258.  
  1259. (****** rexxdossupport.library/SetProtection *******************
  1260. *
  1261. *   NAME
  1262. *       SetProtection -- Set protection for a file or directory (V2)
  1263. *
  1264. *   SYNOPSIS
  1265. *       success = SetProtection( name, mask )
  1266. *
  1267. *   FUNCTION
  1268. *       SetProtection() sets the protection attributes on a file or
  1269. *       directory.  See <dos/dos.h> for a listing of protection bits.
  1270. *
  1271. *       The archive bit should be cleared by the filesystem whenever
  1272. *       the file is changed.  Backup utilities will generally set the
  1273. *       bit after backing up each file.
  1274. *
  1275. *       The V36 Shell looks at the execute bit, and will refuse to
  1276. *       execute a file if it is set.
  1277. *
  1278. *       Other bits will be defined in the <dos/dos.h>include files.
  1279. *       Rather than referring to bits by number you should use the
  1280. *       definitions in <dos/dos.h>.
  1281. *
  1282. *   INPUTS
  1283. *       name     - name of file or directory to set protection
  1284. *       mask     - the protection mask required
  1285. *
  1286. *   RESULT
  1287. *       success - If TRUE, the variable was sucessfully deleted,
  1288. *                 FALSE indicates failure.
  1289. *
  1290. *       RC (rexx variable) - contains the dos error code if the
  1291. *               function was not successfull. This can can directly
  1292. *               be used as input for Fault().
  1293. *
  1294. *   SEE ALSO
  1295. *       SetComment(), Fault(), dos.library/SetProtection()
  1296. *
  1297. **************************)
  1298.  
  1299. PROCEDURE SetProtection (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1300. VAR
  1301.   retval: INTEGER;
  1302. CONST
  1303.   argFile = 1; argFlags = 2;
  1304. TYPE
  1305.   LONGSETPtr = UNTRACED POINTER TO LONGSET;
  1306. BEGIN
  1307.   IF ~ rls.ArgsPresent(msg,argFile,argFlags)
  1308.   OR (rxs.LengthArgstring(msg.args[argFlags]) # 4)
  1309.     THEN RETURN invalidArg; END;
  1310.   retval := rx.ok;
  1311.   IF d.SetProtection(msg.args[argFile]^,y.VAL(LONGSETPtr,msg.args[argFile])^) THEN
  1312.     resultStr := rxs.CreateArgstring(strTRUE,1);
  1313.   ELSE
  1314.     resultStr := rxs.CreateArgstring(strFALSE,1);
  1315.     retval := rls.SetRC(msg,d.IoErr());
  1316.   END;
  1317.   IF resultStr = NIL THEN retval := noMemory; END;
  1318.   RETURN retval;
  1319. END SetProtection;
  1320.  
  1321.  
  1322. (****** rexxdossupport.library/AbsolutePath *******************
  1323. *
  1324. *   NAME
  1325. *       AbsolutePath -- Returns the fully qualified path of a file or dir (V3)
  1326. *
  1327. *   SYNOPSIS
  1328. *       path = AbsolutePath( name )
  1329. *
  1330. *   FUNCTION
  1331. *       Determines the absolute path of a file or directory.
  1332. *
  1333. *   INPUTS
  1334. *       name  - file or directory name
  1335. *
  1336. *   RESULT
  1337. *       path  - absolute path to file/dir
  1338. *
  1339. *       RC (rexx variable) - 5 when file does not exist,
  1340. *                            0 otherwise
  1341. *
  1342. *   EXAMPLE
  1343. *       /* */
  1344. *       path = AbsolutePath(":s/Startup-Sequence")
  1345. *       if RC = 5 then
  1346. *         say "File ':s/Startup-Sequence' does not exist"
  1347. *       else
  1348. *         say "':s/Startup-Sequence' is '" || path || "'"
  1349. *
  1350. *   SEE ALSO
  1351. *     dos.library/NameFromLock()
  1352. *
  1353. **********************)
  1354.  
  1355. PROCEDURE AbsolutePath (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1356. VAR
  1357.   len: LONGINT;
  1358.   res: BOOLEAN;
  1359.   lock: d.FileLockPtr;
  1360.   buffer: ARRAY 512 OF CHAR;
  1361. CONST
  1362.   argName = 1;
  1363. BEGIN
  1364.   lock := d.Lock(msg.args[argName]^, d.sharedLock);
  1365.   IF lock = NIL THEN RETURN rls.SetRC5(msg) END;
  1366.   res := d.NameFromLock(lock, buffer, SIZE(buffer));
  1367.   d.UnLock(lock); lock := NIL;
  1368.   IF ~ res THEN RETURN rls.SetRC5(msg) END;
  1369.   resultStr := rxs.CreateArgstring(buffer,str.Length(buffer));
  1370.   IF resultStr = NIL THEN RETURN noMemory; END;
  1371.   RETURN rls.SetRC0(msg);
  1372. END AbsolutePath;
  1373.  
  1374. (****** rexxdossupport.library/AddPart *******************
  1375. *
  1376. *   NAME
  1377. *       AddPart -- Appends a file/dir to the end of a path (V3)
  1378. *
  1379. *   SYNOPSIS
  1380. *       newpath = AddPart( dirname , filename )
  1381. *
  1382. *   FUNCTION
  1383. *       This funktion adds a file, directory, or subpath name to a
  1384. *       directory path name taking into account any required
  1385. *       seperator charakters.
  1386. *
  1387. *   INPUTS
  1388. *       dirname  - the path to add a fir/directory name to.
  1389. *       filename - the filename or directory name to add.
  1390. *
  1391. *   RESULT
  1392. *       newpath  - resulting path.
  1393. *
  1394. *       RC (rexx variable) - 5 when file does not exist,
  1395. *                            0 otherwise
  1396. *
  1397. *   EXAMPLE
  1398. *       /* */
  1399. *       path = AddPart("System:s/","Startup-Sequence")
  1400. *       if RC = 0 then say path
  1401. *         /* --> System:s/Startup-Sequence */
  1402. *
  1403. *       path = AddPart("System:s/bla",":Startup-Sequence")
  1404. *       if RC = 0 then say path
  1405. *         /* --> System:Startup-Sequence */
  1406. *
  1407. *       path = AddPart("System:s/bla","/Startup-Sequence")
  1408. *       if RC = 0 then say path
  1409. *         /* --> System:s/bla//Startup-Sequence */
  1410. *
  1411. *   BUGS
  1412. *       Neither the input dirname nor the resulting path must exceed
  1413. *       511 Bytes. If a string overflow occurrs, error 'string too
  1414. *       long' will be returned which ARexx outputs as 'string > 65535
  1415. *       charakters'.
  1416. *
  1417. *   SEE ALSO
  1418. *       dos.library/AddPart(), FilePart(), PathPart()
  1419. *
  1420. **********************)
  1421.  
  1422. PROCEDURE AddPart (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1423. VAR
  1424.   buffer: ARRAY 512 OF CHAR;
  1425. CONST
  1426.   argDir = 1; argFile = 2;
  1427. BEGIN
  1428.   IF str.Length(msg.args[argDir]^) >= SIZE(buffer) THEN
  1429.     RETURN stringTooLong END;
  1430.   COPY(msg.args[argDir]^, buffer);
  1431.   IF ~ d.AddPart(buffer, msg.args[argFile]^, SIZE(buffer)) THEN
  1432.     RETURN stringTooLong END;
  1433.   resultStr := rxs.CreateArgstring(buffer, str.Length(buffer));
  1434.   IF resultStr = NIL THEN RETURN noMemory; END;
  1435.   RETURN rls.SetRC0(msg);
  1436. END AddPart;
  1437.  
  1438. (****** rexxdossupport.library/FilePart *******************
  1439. *
  1440. *   NAME
  1441. *       FilePart -- Returns the last component of a path (V3)
  1442. *
  1443. *   SYNOPSIS
  1444. *       part = FilePart( path )
  1445. *
  1446. *   FUNCTION
  1447. *       This function returns the last component of a string path
  1448. *       specification, which will normally be the file name.  If there is
  1449. *       only one component, it returns the complete string.
  1450. *
  1451. *   INPUTS
  1452. *       path - pointer to an path string.  May be relative to the current
  1453. *              directory or the current disk.
  1454. *
  1455. *   RESULT
  1456. *       part  - resulting path part.
  1457. *
  1458. *   EXAMPLE
  1459. *       /* */
  1460. *       say FilePart("xxx:yyy/zzz/qqq")
  1461. *         /* --> qqq */
  1462. *       say FilePart("xxx:yyy")
  1463. *         /* --> yyy */
  1464. *
  1465. *   SEE ALSO
  1466. *       dos.library/FilePart(), AddPart(), PathPart()
  1467. *
  1468. **********************)
  1469.  
  1470. PROCEDURE FilePart (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1471. VAR
  1472.   filePart: e.LSTRPTR;
  1473. CONST
  1474.   argPath = 1;
  1475. BEGIN
  1476.   filePart := d.FilePart(msg.args[argPath]^);
  1477.   resultStr := rxs.CreateArgstring(filePart^,str.Length(filePart^));
  1478.   IF resultStr = NIL THEN RETURN noMemory END;
  1479.   RETURN rls.SetRC0(msg);
  1480. END FilePart;
  1481.  
  1482. (****** rexxdossupport.library/PathPart *******************
  1483. *
  1484. *   NAME
  1485. *       PathPart -- Strips the next-to-last component of a path. (V3)
  1486. *
  1487. *   SYNOPSIS
  1488. *       part = PathPart( path )
  1489. *
  1490. *   FUNCTION
  1491. *       This function strips the next-to-last component of a path
  1492. *       specification, which will normally result in the directory name.
  1493. *       If there is only one component, it returns an empty string.
  1494. *
  1495. *   INPUTS
  1496. *       path - path string.  May be relative to the current directory or
  1497. *             the current disk.
  1498. *
  1499. *   RESULT
  1500. *       part  - resulting path part.
  1501. *
  1502. *   EXAMPLE
  1503. *       /* */
  1504. *       say FilePart("xxx:yyy/zzz/qqq")
  1505. *         /* --> xxx:yyy/zzz */
  1506. *       say FilePart("xxx:yyy")
  1507. *         /* --> xxx: */
  1508. *
  1509. *   SEE ALSO
  1510. *       dos.library/PathPart(), AddPart(), FilePart()
  1511. *
  1512. **********************)
  1513.  
  1514. PROCEDURE PathPart (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1515. VAR
  1516.   fullPath, pathPart: e.LSTRPTR;
  1517.   len: LONGINT;
  1518. CONST
  1519.   argPath = 1;
  1520. BEGIN
  1521.   fullPath := msg.args[argPath];
  1522.   pathPart := d.PathPart(fullPath^);
  1523.   len := PointerArithmetics.Subtract(pathPart,fullPath);
  1524.   resultStr := rxs.CreateArgstring(fullPath^,len);
  1525.   IF resultStr = NIL THEN RETURN noMemory END;
  1526.   RETURN rls.SetRC0(msg);
  1527. END PathPart;
  1528.  
  1529. (* ---------------------------------------------------------------- *)
  1530.  
  1531. PROCEDURE Dispatch * (msg{8}: rx.RexxMsgPtr): LONGINT; (* $SaveRegs+ *)
  1532. VAR
  1533.   resultStr: e.LSTRPTR;
  1534.   retval: LONGINT;
  1535. BEGIN
  1536.   ol.SetA5();
  1537.   retval := rls.Dispatch(msg,resultStr,functionList);
  1538.   y.SETREG(8,resultStr);
  1539.   RETURN retval;
  1540. END Dispatch;
  1541.  
  1542. BEGIN
  1543.   IF (rxs.base = NIL) OR (d.base.lib.version < 37) THEN HALT(20); END;
  1544.  
  1545. END rexxdossupport.
  1546.